home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d12 / ptv1n6.arc / POLITE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-01-21  |  8KB  |  251 lines
  1. {
  2.  
  3.          TITLE : POLITE.TPU,  Version 9004.05
  4.        PURPOSE : Unit that allows saving and restoring DOS states.
  5.         AUTHOR : David Gerrold, CompuServe ID:  70307,544
  6.    ________________________________________________________________
  7.  
  8.     Written in Turbo Pascal, Version 5.5,
  9.     with routines from TurboPower, Object Professional.
  10.  
  11.     Turbo Pascal is a product of Borland International.
  12.     Object Professional is a product of TurboPower Software.
  13.    ________________________________________________________________
  14.  
  15.     This is not public domain software.
  16.     This software is copyright 1990, by David Gerrold.
  17.     Permission is hereby granted for personal use.
  18.  
  19.          The Brass Cannon Corporation
  20.          9420 Reseda Blvd., #804
  21.          Northridge, CA  91324-2932.
  22.  
  23.                                                                    }
  24.  
  25. { Compiler Directives ============================================ }
  26.  
  27. {$R-}    {Range checking off}
  28. {$B-}    {Boolean complete evaluation off}
  29. {$S-}    {Stack checking off}
  30. {$I-}    {I/O checking off}
  31. {$N+,E+} {Simulate numeric coprocessor}
  32. {$M 16384,0,327680} {stack and heap}
  33. {$V-}    {Variable range checking off}
  34.  
  35. { Name =========================================================== }
  36.  
  37. UNIT Polite;
  38. {
  39.   The purpose of this unit is to automate the process of writing
  40.   a well-behaved program.  A well-behaved program should save the
  41.   state of the operating system before the program begins running,
  42.   and then restore the system to that state again after the program
  43.   concludes.
  44.  
  45.   This means that the program must:
  46.     * restore the operative display mode
  47.     * restore the cursor to the same size
  48.     * if necessary, restore the cursor to the same location
  49.     * if necessary, restore the previous contents of the screen
  50.  
  51.   In addition, the program should
  52.     * restore the state of Ctrl-Break
  53.     * restore a damaged cursor
  54.  
  55.   This unit also includes code to
  56.     * automatically note the time the program began,
  57.       for logging functions
  58.     * automatically randomize, for game programs
  59.  
  60.   To use, simply include this unit as the first one in your
  61.   program's USES statement, or include these routines in your own
  62.   initialization unit.
  63.  
  64.   To save and restore the state of the DOS screen, frame your main
  65.   code with the OpenProgram and CloseProgram procedures:
  66.  
  67.      BEGIN
  68.        OpenProgram;
  69.        ...
  70.        DoSomeStuff;
  71.        ...
  72.        CloseProgram;
  73.      END.
  74. }
  75.  
  76. { Interface ====================================================== }
  77.  
  78. INTERFACE
  79.  
  80. USES
  81. { Object Professional Units }
  82.   OpCrt,
  83.   OpDate,
  84.   OpString;
  85.  
  86. { Declarations =================================================== }
  87.  
  88. VAR
  89.   LogOnTime : DateTimeRec;                  { time program started }
  90.  
  91. { Save and Restore DOS screen ------------------------------------ }
  92.  
  93. PROCEDURE OpenProgram;
  94. {
  95.   Save Dos screen.
  96.   MUST be used with CloseProgram, MUST be first statement in program.
  97. }
  98.  
  99. PROCEDURE CloseProgram;
  100. {
  101.   Restore Dos screen.
  102.   MUST be used with OpenProgram, MUST be last statement in program.
  103. }
  104.  
  105. { Implementation ================================================= }
  106.  
  107. IMPLEMENTATION
  108.  
  109. { Open and Close Variables ======================================= }
  110.  
  111. VAR
  112.   CursorLoc  : word;                             { DOS cursor loc }
  113.   CursorSize : word;                            { DOS cursor size }
  114.  
  115.   DosMode    : word;                          { DOS mode at start }
  116.   DosScreen  : pointer;                        { saved DOS screen }
  117.  
  118. { Open Program =================================================== }
  119.  
  120. PROCEDURE OpenProgram;
  121. {
  122.   Save DOS screen.
  123.   MUST be used with CloseProgram, -MUST be 1st statement in program.
  124. }
  125. VAR
  126.   Flag : boolean;
  127.  
  128. BEGIN
  129. {
  130.   Save the DOS mode.  If text mode, save the screen.
  131. }
  132.   DosMode := CurrentMode;                    { save existing mode }
  133.   Case DosMode of
  134.     bw80,
  135.     co80,
  136.     Mono : Flag := SaveWindow (1, 1, 80, 25, true, DosScreen);
  137.         { false means not enough heap space to store saved window }
  138.     end;  { case }
  139.  
  140.   If DefColorChoice = ForceMono
  141.     then TextMode (bw80)
  142.     else TextMode (co80);
  143.   HiddenCursor;                              { turn off cursor }
  144. END;
  145.  
  146. { CloseProgram ================================================== }
  147.  
  148. PROCEDURE CloseProgram;
  149. {
  150.   Restore DOS screen.
  151.   MUST be used with OpenProgram, MUST be last statement in program.
  152. }
  153.  
  154. BEGIN
  155.   If DosMode <> CurrentMode then
  156.     TextMode (DosMode);                   { restore previous mode }
  157.   Case DosMode of
  158.     bw80,
  159.     co80,
  160.     Mono  : If DosScreen <> nil then begin
  161.             RestoreWindow (1, 1, 80, 25, true, DosScreen);
  162.             RestoreCursorState (CursorLoc, CursorSize); { curs. on }
  163.             end;
  164.     end;  {case}
  165. END;
  166.  
  167. { Initialization Variables ======================================= }
  168.  
  169. VAR
  170.   ExitSave     : pointer;                    { for ExitProc }
  171.   Loop         : byte;                       { for initialization }
  172.  
  173. { ExitUnit ======================================================= }
  174.  
  175. {$F+} PROCEDURE ExitUnit; {$F-}
  176.  
  177. BEGIN
  178.   ExitProc := ExitSave;                   { reset original address }
  179.   SetCursorSize (hi (CursorSize), lo (CursorSize));
  180.   NormVideo;                              { sets original TextAttr }
  181.                                           { return to DOS }
  182. END;
  183.  
  184. { Initialization ================================================= }
  185.  
  186. BEGIN
  187.   ExitSave := ExitProc;                   { save old address }
  188.   ExitProc := @ExitUnit;                  { get new exit address }
  189.  
  190. {
  191.   OpCrt forces break-checking off when a program begins and restores
  192.   it to its former state when the program ends. See the Turbo Pascal
  193.   reference manual for details on GetCBreak & SetCBreak procedures.
  194. }
  195.  
  196. { Check for mono ------------------------------------------------- }
  197. {
  198.   If the current display is not capable of color or the user has set
  199.   his display to mono mode, we need to force mono attributes.
  200. }
  201.   Case CurrentDisplay of
  202.     MonoHerc : DefColorChoice := ForceMono;
  203.     end;  {case}
  204.   Case CurrentMode of
  205.     bw40, bw80, Mono : DefColorChoice := ForceMono;
  206.     end;  {case}
  207.  
  208. {
  209.   There is no way that a program can tell if a user has a color card
  210.   connected to a bw monitor.  To force a bw display, let the user
  211.   call the program with the command line option of '-bw' or '/bw'.
  212.   The program will look through the ParamStrs and set DefColorChoice
  213.   to ForceMono.
  214.  
  215.   For this to work, however, EVERY color choice called must be mapped
  216.   with OpCrt's ColorMono (color, mono) function.
  217. }
  218.   For Loop := 1 to ParamCount do
  219.     if
  220.       (CompUCString ('/bw', ParamStr (Loop)) = equal)
  221.         or
  222.       (CompUCString ('-bw', ParamStr (Loop)) = equal)
  223.     then
  224.       DefColorChoice := ForceMono;
  225.  
  226.   TextAttr := ColorMono (Yellow, LightGray); { set new attributes }
  227.  
  228. { Initialize the cursor ------------------------------------------ }
  229.  
  230.   GetCursorState (CursorLoc, CursorSize);  { save cursor loc, size }
  231.   dec (CursorLoc, 256);                   { adjust cursor row up 1 }
  232. {
  233.   There are some very obscure situations in which DOS will hide the
  234.   cursor, leaving the scan lines set for 32 and 0.  This code will
  235.   detect that situation and will restore the cursor to a normal size
  236.   for the DOS text mode.  It may be incompatible with TSR routines
  237.   that turn the cursor off and fake a non-blinking cursor. I haven't
  238.   tested it.  Feedback would be appreciated.
  239. }
  240.   If CursorSize = $2000 then CursorSize := $0607;
  241.  
  242. {
  243.   Log what time the program started, randomize the random num. seed.
  244. }
  245.   LogOnTime.T := CurrentTime;            { what time did we start? }
  246.   LogOntime.D := Today;                  { what day is today? }
  247.   Randomize;                             { for games, etc. }
  248. END.
  249.  
  250. { ================================================================ }
  251.